home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRIC / DSPICE0S.ZIP / errmem.c < prev    next >
C/C++ Source or Header  |  1992-11-22  |  6KB  |  189 lines
  1. /* errmem.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  12.         sfactr;
  13.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  14.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  15. } status_;
  16.  
  17. #define status_1 status_
  18.  
  19. struct {
  20.     doublereal cpyknt;
  21.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  22.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  23.         nwd16;
  24. } memmgr_;
  25.  
  26. #define memmgr_1 memmgr_
  27.  
  28. /* Table of constant values */
  29.  
  30. static integer c__1 = 1;
  31.  
  32. /*<       subroutine errmem(inam,ierror,ipntr) >*/
  33. /* Subroutine */ int errmem_(inam, ierror, ipntr)
  34. integer *inam, *ierror, *ipntr;
  35. {
  36.     /* Initialized data */
  37.  
  38.     static struct {
  39.     char e_1[56];
  40.     doublereal e_2;
  41.     } equiv_9 = { {'c', 'l', 'r', 'm', 'e', 'm', ' ', ' ', 'e', 'x', 't', 
  42.         'm', 'e', 'm', ' ', ' ', 'g', 'e', 't', 'm', 'e', 'm', ' ', 
  43.         ' ', 'p', 't', 'r', 'm', 'e', 'm', ' ', ' ', 'r', 'e', 'l', 
  44.         'm', 'e', 'm', ' ', ' ', 's', 'e', 't', 'm', 'e', 'm', ' ', 
  45.         ' ', 's', 'i', 'z', 'm', 'e', 'm', ' ', ' '}, 0. };
  46.  
  47. #define errnam ((doublereal *)&equiv_9)
  48.  
  49.  
  50.     /* Format strings */
  51.     static char fmt_201[] = "(\0020memory manager variables nwd4-8-16 incomp\
  52. atible with nxtevn and nxtmem\002)";
  53.     static char fmt_301[] = "(\0020*error*:  memory requirement exceeds mach\
  54. ine capacity\002,/\0020 memory needs exceed\002,i6)";
  55.     static char fmt_411[] = "(\0020size parameter negative\002)";
  56.     static char fmt_421[] = "(\0020attempt to reallocate existing table\002)";
  57.  
  58.     static char fmt_511[] = "(\0020table pointer invalid\002)";
  59.     static char fmt_531[] = "(\0020attempt to release more than total tabl\
  60. e\002)";
  61.     static char fmt_901[] = "(\0020*abort*:  internal memory manager error a\
  62. t entry \002,a7)";
  63.  
  64.     /* Builtin functions */
  65.     integer s_wsfe(), e_wsfe(), do_fio();
  66.     /* Subroutine */ int s_stop();
  67.  
  68.     /* Local variables */
  69.     extern /* Subroutine */ int dmpmem_();
  70.  
  71.     /* Fortran I/O blocks */
  72.     static cilist io__2 = { 0, 0, 0, fmt_201, 0 };
  73.     static cilist io__3 = { 0, 0, 0, fmt_301, 0 };
  74.     static cilist io__4 = { 0, 0, 0, fmt_411, 0 };
  75.     static cilist io__5 = { 0, 0, 0, fmt_421, 0 };
  76.     static cilist io__6 = { 0, 0, 0, fmt_511, 0 };
  77.     static cilist io__7 = { 0, 0, 0, fmt_531, 0 };
  78.     static cilist io__8 = { 0, 0, 0, fmt_901, 0 };
  79.  
  80.  
  81.     /* Parameter adjustments */
  82.     --ipntr;
  83.  
  84.     /* Function Body */
  85. /*<       implicit double precision (a-h,o-z) >*/
  86. /*<       dimension ipntr(1) >*/
  87. /* spice version 2g.6  sccsid=status 3/15/83 */
  88. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  89. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  90. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  91. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  92. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  93. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  94. /*<      2   nwd8,nwd16 >*/
  95. /*<       dimension errnam(7) >*/
  96. /*<       data errnam /6hclrmem,6hextmem,6hgetmem,6hptrmem,6hrelmem, >*/
  97. /*<      1   6hsetmem,6hsizmem/ >*/
  98.  
  99. /*<       go to (200,410,420,300,510,530),ierror >*/
  100.     switch (*ierror) {
  101.     case 1:  goto L200;
  102.     case 2:  goto L410;
  103.     case 3:  goto L420;
  104.     case 4:  goto L300;
  105.     case 5:  goto L510;
  106.     case 6:  goto L530;
  107.     }
  108.  
  109. /* *** error(s) found *** */
  110.  
  111. /* .. nxtevn and/or nxtmem incompatible with nwd4, nwd8, and nwd16 */
  112.  
  113. /*<   200 write(iofile,201) >*/
  114. L200:
  115.     io__2.ciunit = status_1.iofile;
  116.     s_wsfe(&io__2);
  117.     e_wsfe();
  118. /*<   201 format('0memory manager variables nwd4-8-16 incompatible with nxte >*/
  119. /*<      1vn and nxtmem') >*/
  120. /*<       go to 900 >*/
  121.     goto L900;
  122.  
  123. /* ...  memory needs exceed maximum available space */
  124. /*<   300 write (iofile,301) maxmem >*/
  125. L300:
  126.     io__3.ciunit = status_1.iofile;
  127.     s_wsfe(&io__3);
  128.     do_fio(&c__1, (char *)&memmgr_1.maxmem, (ftnlen)sizeof(integer));
  129.     e_wsfe();
  130. /*<   301 format('0*error*:  memory requirement exceeds machine capacity', >*/
  131. /*<      1/'0 memory needs exceed',i6) >*/
  132. /*<       go to 900 >*/
  133.     goto L900;
  134. /* ...    *isize* < 0 */
  135. /*<   410 write(iofile,411) >*/
  136. L410:
  137.     io__4.ciunit = status_1.iofile;
  138.     s_wsfe(&io__4);
  139.     e_wsfe();
  140. /*<   411 format('0size parameter negative') >*/
  141. /*<       go to 900 >*/
  142.     goto L900;
  143. /* ...  getmem:  attempt to reallocate existing block */
  144. /*<   420 write(iofile,421) >*/
  145. L420:
  146.     io__5.ciunit = status_1.iofile;
  147.     s_wsfe(&io__5);
  148.     e_wsfe();
  149. /*<   421 format('0attempt to reallocate existing table') >*/
  150. /*<       go to 900 >*/
  151.     goto L900;
  152. /* ...    *ipntr* invalid */
  153. /*<   510 write(iofile,511) >*/
  154. L510:
  155.     io__6.ciunit = status_1.iofile;
  156.     s_wsfe(&io__6);
  157.     e_wsfe();
  158. /*<   511 format('0table pointer invalid') >*/
  159. /*<       go to 900 >*/
  160.     goto L900;
  161. /* ...  relmem:  *isize* larger than indicated block */
  162. /*<   530 write(iofile,531) >*/
  163. L530:
  164.     io__7.ciunit = status_1.iofile;
  165.     s_wsfe(&io__7);
  166.     e_wsfe();
  167. /*<   531 format('0attempt to release more than total table') >*/
  168. /* ...  issue error message */
  169. /*<   900 write (iofile,901) errnam(inam) >*/
  170. L900:
  171.     io__8.ciunit = status_1.iofile;
  172.     s_wsfe(&io__8);
  173.     do_fio(&c__1, (char *)&errnam[*inam - 1], (ftnlen)sizeof(doublereal));
  174.     e_wsfe();
  175. /*<   901 format('0*abort*:  internal memory manager error at entry ', >*/
  176. /*<      1  a7) >*/
  177. /*<   950 call dmpmem(ipntr(1)) >*/
  178. /* L950: */
  179.     dmpmem_(&ipntr[1]);
  180. /*<  1000 stop >*/
  181. /* L1000: */
  182.     s_stop("", 0L);
  183. /*<       end >*/
  184. } /* errmem_ */
  185.  
  186. #undef errnam
  187.  
  188.  
  189.